home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Yerk 3.6.8 / Toolbox Classes / dialog < prev    next >
Encoding:
Text File  |  1995-10-21  |  5.6 KB  |  192 lines  |  [TEXT/YERK]
  1. \ Dialog support
  2. \ 12/22/84  cbd Version 1
  3. \  7/23/85  cbd Fixed get:, added ReturnToModal
  4. \  9/06/85  cdn putText & getText made to work with Control items
  5. \  9/20/85  cdn Added draw:, disp: & ParamText
  6. \  7/10/86  cdn Fixed ReturnToModal, added setProc:
  7. \  7/21/86  cdn Added togItem
  8. \ 10/10/86  cdn Added hilite:
  9. \  5/20/90    rfl    the actual hilite is now a frame: method
  10. \ 11/21/90    rfl    added setUserItem and UserItem class
  11. \ 12/24/90    rfl    dialog items now match array items.  First item in
  12. \                dialog array is at position 1.  Position 0 does nothing. Actions: replaced
  13. \ 10/31/91    rfl    modifed userItem to set its rectangle at set time
  14. \ 12/13/91    rfl    SP added alive:
  15. \  9/28/92    rfl    added portBit: to make consistent with portBit: window
  16. \  5/13/93    rfl    protected getnew
  17. \ 10/22/93    rfl changed setProc to store cfa, do >body in modal:
  18. \ 10/08/94    rfl    added an alive: check for draw:
  19. \ 10/21/95    rfl    added 1 hilite: self to classinit
  20.  
  21. Decimal
  22.  
  23. : Closer  close: caller ;
  24.  
  25. Int theItem
  26. Var itemHandle
  27. Int itemType
  28.  
  29. 0 value rtm
  30.  
  31. :CLASS  Dialog  <Super X-Array
  32.  
  33.     Int        Resid
  34.     Var        dialPtr
  35.     Var        procPtr
  36.     Int        boldItem
  37.  
  38.     \ ( -- )
  39.     :M  CLOSE:  get: dialPtr  call DisposDialog clear: dialPtr  ;M
  40.  
  41.     :M  ALIVE: ( -- b) get: dialPtr 0 <> ;M
  42.  
  43.     :M  SET: get: dialPtr call setPort ;M
  44.  
  45.     :M  PORTBIT: ( -- abs) get: dialPtr 2+ ;M
  46.  
  47.     \ ( item# -- hndl )  get handle for item#
  48.     :M  HANDLE:  { item# -- hndl }  get: dialPtr  item# makeInt
  49.         abs: itemType  abs: itemHandle  abs: tempRect
  50.         call GetDItem get: itemHandle  ;M
  51.  
  52.     \ draws the frame around the hilit item
  53.     :M  FRAME:     get: boldItem -dup
  54.         IF    savePort get: dialPtr call SetPort 3 3 pack call PenSize
  55.             handle: self drop -4 -4 inset: tempRect
  56.             abs: tempRect 16 16 pack call FrameRoundRect call penNormal restPort
  57.         THEN ;M
  58.  
  59.     \ ( -- )  create dialog from resID
  60.     :M  GETNEW:  0 int: resid 0 -1  call GetNewDialog dup put: dialPtr
  61.         0= classErr" 170
  62.         frame: self    ;M
  63.  
  64.     :M  SHOW: get: dialPtr call showWindow frame: self ;M
  65.  
  66.     \ ( cfa -- )  set dialog proc
  67.     :M  SETPROC:  put: procPtr ;M
  68.  
  69.     \ ( -- )  display as modal dialog
  70.     :M  MODAL:
  71.         BEGIN
  72.             get: procPtr dup IF >body +base THEN abs: theItem call ModalDialog
  73.             get: theItem ( 1-) exec: super
  74.             rtm
  75.         WHILE
  76.             0 -> rtm    \ iterate every time ReturnToModal is executed
  77.         REPEAT
  78.     ;M
  79.  
  80.     \ ( act0 ... actN -- )  set the dialog's action handlers starting at element 1
  81.     :M  ACTIONS: ?ixobj limit 1- 0
  82.         DO limit i- 1- (^elem) !
  83.         LOOP   ;M
  84.  
  85.     \ ( val item# -- )
  86.     :M  PUT:  handle: self  swap makeInt call SetCtlValue   ;M
  87.  
  88.     \ ( item# -- val ) get value for an item#
  89.     :M  GET:   handle: self  >R word0 R>
  90.         call GetCtlValue word0  ;M    \ added word0 cbd 7/17/85
  91.  
  92.     \ ( resID -- )  Associate object with it's resource
  93.     :M  INIT:  put: resID   ;M
  94.  
  95.     :M  PUTRESID: put: resID ;M
  96.  
  97.     \ ( item# -- )  Causes bold outline of the specified item
  98.     :M  HILITE: put: boldItem ;M
  99.  
  100.     \ ( item# -- addr len )  return a text item's text
  101.     :M  GETTEXT: handle: self  buf255 +base   get: ItemType dup 24 and
  102.         IF   drop call GetIText
  103.         ELSE 4 and
  104.              IF   call GetCTitle
  105.              ELSE 2drop 0 buf255 c!        \ user item has no text
  106.             THEN
  107.         THEN
  108.         buf255 count  ;M
  109.  
  110.     \ ( addr len item# -- )  store an item's text
  111.     :M  PUTTEXT: { addr len item# -- } item#  handle: self
  112.         addr len str255   get: ItemType dup 24 and
  113.         IF   drop call SetIText
  114.         ELSE 4 and
  115.              IF   call SetCTitle
  116.              ELSE 2drop                    \ user item has no text
  117.              THEN
  118.         THEN   ;M
  119.  
  120.     \ ( start end item# )  set selection range for text item
  121.     :M  SETSELECT:  { start end item# -- }  get: dialPtr
  122.         item# makeInt start end pack  call SeliText  ;M
  123.  
  124.     \ ( -- )  force drawing of dialog before going to modal:
  125.     :M  DRAW:   alive: self IF get: dialPtr call DrawDialog THEN ;M
  126.  
  127.     \  set user item into dialog; userItem must start with rectangle data
  128.     :M  SETUSERITEM: { userItem -- } item: useritem handle: self drop
  129.         get: tempRect put: userItem
  130.         get: itemType $ 80 and
  131.         IF disable: userItem ELSE enable: userItem THEN
  132.         get: dialPtr getParms: userItem abs: userItem call setDItem ;M
  133.  
  134.     \ ( -- )  Initialize default handlers to close the dialog box
  135.     :M  CLASSINIT:  limit 0 DO 'c closer i to: self LOOP  1  hilite: self ;M
  136.  
  137. ;CLASS
  138.  
  139. \ signal modal method to re-enter ModalDialog
  140. : ReturnToModal
  141.     1 -> rtm ;
  142.  
  143. \ Toggle the check box or radio button
  144. : togItem
  145.     get: theItem 1 over get: caller - swap put: caller
  146.     ReturnToModal
  147. ;
  148.  
  149. \ ( addr0 len0 addr1 len1 addr2 len2 addr3 len3 -- )  Substitute Dialog text
  150. : ParamText { \ p1 p2 p3 -- }
  151.      str255 dup -> p3   -base count +
  152.     >str255 dup -> p2   -base count +
  153.     >str255 dup -> p1   -base count +
  154.     >str255     p1 p2 p3 call ParamText
  155. ;
  156.  
  157.  
  158. \    11.21.90    rfl    User Item class for use in dialogs. The proc definition should conform
  159. \                    to IM where the proc draws the item; for example, if the item is a clock,
  160. \                     it wil draw the clock with the current time displayed. When this procedure
  161. \                     is called, the current port will have been set by the Dialog Manager to the
  162. \                     dialog window's grafport. The procedure must have two parameters, a
  163. \                     window pointer and an item number.  If the procedure draws in more than
  164. \                     one dialog window, the ptr tells it which one to draw in. The item number
  165. \                     tells it which item to draw, if it draws more than one. Since itemNo
  166. \                     is an integer, must add word0 to make long.
  167.  
  168. :CLASS userItem <super rect
  169.  
  170.     var myProc
  171.     int    disabled
  172.     int itemNo
  173.  
  174.   :M item:         ( -- n)        get: itemNo ;M
  175.   :M putItem:     ( n --)     put: itemNo ;M
  176.  
  177.   :M disabled?: ( -- int)    int: disabled ;M
  178.  
  179.   :M disable:     ( --)        128 put: disabled ;M
  180.  
  181.   :M enable:     ( --)        clear: disabled ;M
  182.  
  183.   :M setProc:     ( cfaproc --) >body put: myProc ;M
  184.  
  185.   :M getParms:     ( -- int int proc) int: itemNo int: disabled get: myProc +base ;M
  186.  
  187. ;CLASS
  188.  
  189.  
  190. \ example proc to draw Rectangle
  191. \ :PROC drawRect word0 2drop draw: myUserItem ;PROC
  192.